home *** CD-ROM | disk | FTP | other *** search
/ MacHack 1996 / MacHack 1996.toast / Presentations / Presentations ’93 / Voice Toolkit / Voice Window < prev   
Lisp/Scheme  |  1993-05-03  |  2KB  |  70 lines
  1.  
  2. (in-package "VOICE-TOOLKIT")
  3.  
  4. (export '(voice-window window-select window-show
  5.           window-hide add-subviews remove-subviews window-event modal-dialog 
  6.           voice-return-from-modal-dialog window-close))
  7.  
  8. (defclass voice-window (window)
  9.   ((modal :accessor modal :initform nil)))
  10.  
  11. (defmethod identify ((vw voice-window))
  12.   (voice-mapvect (view-subviews vw)
  13.                  #'identify
  14.                  0
  15.                  (length (view-subviews vw))))
  16.  
  17. (defmethod window-select ((vw voice-window))
  18.   (new-voice-window vw)
  19.   (call-next-method vw))
  20.  
  21. (defmethod window-show ((vw voice-window))
  22.   (new-voice-window vw)
  23.   (call-next-method vw))
  24.  
  25. (defmethod window-hide ((vw voice-window))
  26.   (remove-voice-window vw)
  27.   (call-next-method vw))
  28.  
  29. (defmethod add-subviews ((vw voice-window) &rest subviews)
  30.   (apply #'call-next-method (cons vw subviews))
  31.   (new-voice-window vw))
  32.  
  33. (defmethod remove-subviews ((vw voice-window) &rest subviews)
  34.   (apply #'call-next-method (cons vw subviews))
  35.   (new-voice-window vw))
  36.  
  37. (defmethod window-event ((vw voice-window))
  38.   (call-next-method vw))
  39.  
  40. (defmethod voice-handler ((vw voice-window) theAppleEvent reply handlerRefcon)
  41.   (declare (ignore handlerRefcon) (ignore reply))
  42.   (or *voice-system* (progn (setf *voice-system* t) (show-flag)))
  43.   (hear (string-upcase (ccl::ae-get-parameter-char theAppleEvent #$keyDirectObject t))))
  44.  
  45. (install-appleevent-handler :|aevt| :|hear| #'voice-handler)  
  46.  
  47. (defparameter *exit-modal-dialog* nil)
  48.  
  49. (defparameter *modal-dialog-return-value* nil)
  50.  
  51. (defun test-for-exit ()
  52.   (if *exit-modal-dialog*
  53.     (return-from-modal-dialog *modal-dialog-return-value*)))
  54.  
  55. (defmethod modal-dialog ((vw voice-window) &optional close-on-exit eventhook)
  56.   (setf *exit-modal-dialog* nil)
  57.   (setf (modal vw) t)
  58.   (setf *modal-dialog-return-value* nil)
  59.   (call-next-method vw close-on-exit (if (listp eventhook)
  60.                                        (cons #'test-for-exit eventhook)
  61.                                        (list #'test-for-exit eventhook))))
  62.  
  63. (defun voice-return-from-modal-dialog (arg)
  64.   (setf *modal-dialog-return-value* arg)
  65.   (setf *exit-modal-dialog* t))
  66.  
  67. (defmethod window-close ((vw voice-window))
  68.   (if (modal vw)
  69.     (voice-return-from-modal-dialog nil)
  70.     (call-next-method vw)))